home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS01.ADF / ABasicStuff / Graphics / Topography.bas < prev    next >
BASIC Source File  |  1985-12-04  |  2KB  |  64 lines
  1. 10    REM *****************************
  2. 20    REM **** Topography Graphics ****
  3. 30    REM ****    By Clay Stuart   ****
  4. 40    REM ****    Nat Eastham      ****
  5. 50    REM ****    and Ron Daniel   ****
  6. 60    REM ****        10/81        ****
  7. 64    REM ****    Amiga Version    ****
  8. 66    REM ****  By R. Grokett, Jr. ****
  9. 68    REM ****        11/85        ****
  10. 70    REM *****************************
  11. 75    screen 0,3,0
  12. 80    DIM ARR(18,36)
  13. 90    ?"Topography..."
  14. 100   FOR R=1 TO 16
  15. 110   FOR C=1 TO 32
  16. 120   TERRAIN=0
  17. 130   ARR(R,C)=TERRAIN
  18. 140   NEXT C
  19. 150   NEXT R
  20. 160   PEAKS=128*RND(1)
  21. 170   rgb 0,0,0,0:rgb 1,0,0,0:rgb 2,0,0,0
  22. 200   FOR N=1 TO PEAKS
  23. 210   RNR=16*RND(1)+1
  24. 220   RNC=32*RND(1)+1
  25. 225   H=20*RND(1)
  26. 230   HEIGHT=H-2*H*RND(1)
  27. 240   ARR(RNR,RNC)=HEIGHT
  28. 250   ARR(RNR+1,RNC)=HEIGHT/2
  29. 260   ARR(RNR-1,RNC)=HEIGHT/2
  30. 270   ARR(RNR,RNC+1)=HEIGHT/2
  31. 280   ARR(RNR,RNC-1)=HEIGHT/2
  32. 290   NEXT N
  33. 300   GOSUB 2000
  34. 400   XST=30
  35. 410   YST=40
  36. 420   FOR R=1 TO 16
  37. 430   YPL=YST+5*R
  38. 440   draw( XST+5,YPL-ARR(R,1))
  39. 450   FOR C=1 TO 32
  40. 460   XPL=XST+5*C
  41. 470   draw( to XPL,YPL-ARR(R,C))
  42. 480   NEXT C
  43. 490   XST=XST+5
  44. 500   NEXT R
  45. 600   XST=30
  46. 610   YST=40
  47. 620   FOR C=1 TO 32
  48. 630   draw( XST+5,YST+5-ARR(1,C))
  49. 640   FOR R=1 TO 16
  50. 650   XPL=XST+5*R
  51. 660   YPL=YST+5*R
  52. 670   draw( to XPL,YPL-ARR(R,C))
  53. 680   NEXT R
  54. 690   XST=XST+5
  55. 700   NEXT C
  56. 750   rem
  57. 800   GOTO 100
  58. 2000  scnclr
  59. 2010  rgb 3,rnd(1)*13+2,rnd(1)*13+2,rnd(1)*13+2
  60. 2020  pena 3
  61. 2030  get a$:if a$="" then return
  62. 2040  rgb 0,6,9,15:rgb 2,15,15,15
  63. 2060  end
  64.